MAPS
Photo by Peter Schad on Unsplash
There would be no population explosion if people who are trying to keep the wolf from the door
wouldn’t let the stork fly in through the window…
— Evan Esar
Tracking data of adult white storks (Ciconia ciconia) for the years 2014–2016. The position of the storks has been estimated via GPS every 5 minutes. A stork called Gili (ID 2421/HH847) traveled the furthest distance from South Africa to Germany.
data_files <- list.files(path = "archetypes/stork-tracks/data/gps/", pattern="*.csv")
data_files
## [1] "storks-gps-000.csv" "storks-gps-001.csv" "storks-gps-002.csv"
## [4] "storks-gps-003.csv" "storks-gps-004.csv" "storks-gps-005.csv"
## [7] "storks-gps-006.csv" "storks-gps-007.csv" "storks-gps-008.csv"
## [10] "storks-gps-009.csv" "storks-gps-010.csv" "storks-gps-011.csv"
## [13] "storks-gps-012.csv"
stork_gps <- purrr::map_df(data_files,
~read.csv(paste0("archetypes/stork-tracks/data/gps/", .x), stringsAsFactors = FALSE) %>%
mutate(filename = .x))
head(stork_gps, n=10)
stork_gps_wrangled <- stork_gps %>% janitor::clean_names() %>%
mutate(timestamp = as.POSIXlt(timestamp), format = "%Y-%m-%d %H:%M:%S") %>%
select(tag_local_identifier, individual_local_identifier, timestamp, location_long, location_lat, ground_speed, heading)
stork_gps_wrangled <- stork_gps_wrangled %>% arrange(tag_local_identifier, timestamp)
stork_gps_wrangled$year <- as.integer(stork_gps_wrangled$timestamp$year + 1900)
# Years - [1] 112 (2012) 113 (2013) 114 (2014) 115 (2015) 116 (2016)
stork_gps_year <- filter(stork_gps_wrangled, year == 2016)
head(stork_gps_year, n=10)
gili <- filter(stork_gps_year, individual_local_identifier == '2421/HH847/Gili')
head(gili, n=10)
gili_labels <- gili %>% filter(row_number() == 1 | row_number() == n())
gili_labels
stork_gps_rest <- filter(stork_gps_year, individual_local_identifier != '2421/HH847/Gili')
# calculate the distance from previous point
gili_dist <- gili %>%
mutate(plocation_long = lag(location_long), plocation_lat = lag(location_lat)) %>%
rowwise() %>%
mutate(distance = distm( c(plocation_long, plocation_lat), c(location_long, location_lat), fun=distHaversine )) %>%
mutate(km = distance/1000)
gili_dist <- as.data.frame(gili_dist)
# calculate cumulative sum and select samples
gili_dist <- gili_dist %>%
filter(distance > 0) %>%
mutate(cumulative_km = round(cumsum(km), digits=0)) %>%
filter(row_number() %% 750 == 1)
gili_dist
africa <- ne_countries(scale = "small", continent = 'africa', returnclass = "sf")
europe <- ne_countries(scale = "small", continent = 'europe', returnclass = "sf")
europe <- filter(europe, iso_a3 != "RUS")
europe <- filter(europe, iso_a3 != "GUF")
middle_east <- ne_countries(scale = "small", country = c('turkey', 'syria', 'lebanon', 'jordan', 'iraq', 'israel', 'saudi arabia', 'yemen'), returnclass = "sf")
ne_region <- rbind(africa, europe, middle_east)
# natural earth base map
ne_world <- ne_countries(scale = "small", returnclass = "sf")
# removes Antarctica
ne_world <- filter(ne_world, iso_a3 != "ATA")
theme_opts <- theme(
text = element_text(family = "inconsolata"),
plot.title = element_text(color = "black", size = 18, face = "bold", family = "inconsolata"),
plot.subtitle = element_text(color = "black", size = 16, family = "inconsolata"),
plot.caption = element_text(color = "#555555", size = 8, family = "inconsolata"),
plot.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background=element_rect(fill="#cacdcf", colour="#cacdcf"),
panel.border = element_blank(),
axis.text = element_blank(),
axis.line = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
legend.position="none"
)
stork_palette <- c(
"#F44336",
"#E91E63",
"#9C27B0",
"#673AB7",
"#3F51B5",
"#2196F3",
"#03A9F4",
"#00BCD4",
"#009688",
"#4CAF50",
"#8BC34A",
"#FFEB3B"
)
v1 <- ggplot(data = ne_world) +
geom_sf_interactive(aes(tooltip = iso_a3, data_id = iso_a3), fill="#e7e7e5", color="#717c8a", stroke=0.5) +
geom_path( data = stork_gps_rest, aes(x=location_long, y=location_lat, group=factor(tag_local_identifier)), color = "transparent", fill = 'white', size=3, alpha = 0.6) +
geom_path( data = stork_gps_rest, aes(x=location_long, y=location_lat, group=factor(tag_local_identifier), color = individual_local_identifier), size=0.5, alpha = 0.8) +
geom_path( data = gili, aes(x=location_long, y=location_lat, group=factor(tag_local_identifier)), size=4, color = "transparent", fill = 'white', alpha = 0.6) +
geom_path( data = gili, aes(x=location_long, y=location_lat, group=factor(tag_local_identifier)), size=1.5, color = 'orange') +
geom_point( data = gili_dist, aes(x=location_long, y=location_lat), shape = 21, size = 3, color = "white", fill = "black") +
geom_label_repel( data = gili_dist, aes(x=location_long, y=location_lat, label = paste0(cumulative_km, " kilometers\n", timestamp)),
xlim = c(max(gili_dist$location_long)+10, NA),
force_pull = 0, segment.size = 0.5, direction = "both", min.segment.length = 0,
segment.curvature = -0.1, segment.ncp = 3, segment.angle = 20,
size = 4, label.padding = unit(0.5, "lines"), fill = "orange", color = "black", alpha = 0.8, hjust = 0.0) +
geom_point( data = gili_labels, aes(x=location_long, y=location_lat), shape = 21, size = 4, color = "white", fill = "orange") +
geom_label( data = gili_labels, aes(x=location_long, y=location_lat, label = paste0("Gili\n", timestamp)),
nudge_x = -6, size = 4, label.padding = unit(0.5, "lines"), fill = "black", color = "white", hjust = 0.5) +
scale_color_manual(values = stork_palette) +
xlim(-20,60) +
ylim(-35,60) +
theme_bw() +
labs(x="",
y="",
title = "Stork Migration Tracks",
subtitle="Routes Map, 2016") +
theme_opts
girafe(ggobj = v1, width_svg = 12, height_svg = 16,
options = list(opts_sizing(rescale = TRUE, width = 0.5))
)
Rotics S, Kaatz M, Turjeman S, Zurell D, Wikelski M, Sapir N, Eggers U, Fiedler W, Jeltsch F,Nathan R (2018) Early arrival at breeding grounds: causes, costs and a trade-off with over wintering latitude. Journal of Animal Ecology. doi:10.1111/1365-2656.12898 Rotics S, Kaatz M, Turjeman S, Zurell D, Wikelski M, Sapir N, Eggers U, Fiedler W, Jeltsch F,Nathan R (2018) Data from: Early arrival at breeding grounds: causes, costs and a trade-off with over wintering latitude. Movebank Data Repository. doi:10.5441/001/1.v8d24552